home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / mail.swg / 0011_Convert SWAG2QWK.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-08  |  8.8 KB  |  380 lines
  1. {$V-,S-,I-}
  2. {$M 16384,0,355360}   { leave some memory for PKZIP !!! }
  3.  
  4.  
  5. { By POPULAR Request .................
  6.   this SIMPLE program let's you read SWAG files and CONVERT them to QWK
  7.   format readable by many of the popular MAIL readers out there.  I
  8.   tested it with OLX by MUSTANG.  It should would with the others as well.
  9.  
  10.   WARNING ...  Many QWK mail readers are limited in the amount of text
  11.   that can be contained in one message.  SEVERAL of the SWAG files exceed
  12.   what can be read !!  Therefore, you will NOT be able to read all of these.
  13.   Your mail reader program will truncate them.  This was an interesting
  14.   exercise anyway, and shows how QWK mail packets can be created.
  15.  
  16.   Gayle Davis
  17.   November, 1993  }
  18.  
  19. USES
  20.   Dos, Crt;
  21.  
  22. CONST
  23.      ControlHdr : ARRAY [1..11] OF STRING [30] = (
  24.  
  25.  {1} 'SOURCEWARE ARCHIVAL GROUP',
  26.  {2} 'Goshen',
  27.  {3} '875-8133',
  28.  {4} 'Gayle Davis',
  29.  {5} '99999,SWAG',
  30.  {6} '11-03-1993,04:41:37',
  31.  {7} 'SWAG Genius',
  32.  {8} '',     { QMAIL Menu name ???                 }
  33.  {9} '0',    { allways ZERO ???                    }
  34. {10} '0',    { total number of messages in package }
  35. {11} '56');  { number of conferences-1 here        }
  36.              { next is 0 , then first conference   }
  37.  
  38. TYPE
  39.  
  40.   BlockArray   = ARRAY [1..128] OF CHAR;
  41.   CharArray    = ARRAY [1..6] OF CHAR;  { to read in chunks }
  42.   ControlArray = ARRAY [1..200] OF STRING [20];
  43.   bsingle      = array [0..4] of byte;
  44.  
  45.   MSGDATHdr = RECORD  { ALSO the format for SWAG files !!! }
  46.     Status   : CHAR;
  47.     MSGNum   : ARRAY [1..7] OF CHAR;
  48.     Date     : ARRAY [1..8] OF CHAR;
  49.     Time     : ARRAY [1..5] OF CHAR;
  50.     UpTO     : ARRAY [1..25] OF CHAR;
  51.     UpFROM   : ARRAY [1..25] OF CHAR;
  52.     Subject  : ARRAY [1..25] OF CHAR;
  53.     PassWord : ARRAY [1..12] OF CHAR;
  54.     ReferNum : ARRAY [1..8] OF CHAR;
  55.     NumChunk : CharArray;
  56.     Alive    : BYTE;
  57.     LeastSig : BYTE;
  58.     MostSig  : BYTE;
  59.     Reserved : ARRAY [1..3] OF CHAR;
  60.   END;
  61.  
  62. CONST
  63.  
  64.      PKZIP   : PathStr = 'PKZIP.EXE';
  65.  
  66. VAR
  67.  
  68.   SWAGF,
  69.   QWKF        : FILE;
  70.   ControlF    : TEXT;
  71.  
  72.   SavePath,
  73.   SwagPath,
  74.   SWAGFn,
  75.   MsgFName    : PATHSTR;
  76.  
  77.   TR          : SearchRec;
  78.  
  79.   ConfNum,
  80.   Number      : WORD;
  81.  
  82.   MSGHdr      : MSGDatHdr;
  83.   ch          : CHAR;
  84.   count       : INTEGER;
  85.   chunks      : INTEGER;
  86.   ControlVal  : ControlArray;
  87.   ControlIdx  : BYTE;
  88.   WStr        : STRING;
  89.  
  90. FUNCTION TrimL (InpStr : STRING) : STRING; ASSEMBLER;
  91. ASM
  92.       PUSH   DS
  93.       LDS    SI, InpStr
  94.       XOR    AX, AX
  95.       LODSB
  96.       XCHG   AX, CX
  97.       LES    DI, @Result
  98.       INC    DI
  99.       JCXZ   @@2
  100.  
  101.       MOV    BL, ' '
  102.       CLD
  103. @@1 :  LODSB
  104.       CMP    AL, BL
  105.       LOOPE  @@1
  106.       DEC    SI
  107.       INC    CX
  108.       REP    MOVSB
  109.  
  110. @@2 :  XCHG   AX, DI
  111.       MOV    DI, WORD PTR @Result
  112.       SUB    AX, DI
  113.       DEC    AX
  114.       STOSB
  115.       POP    DS
  116. END;
  117.  
  118. FUNCTION TrimR (InpStr : STRING) : STRING;
  119.  
  120. VAR i : INTEGER;
  121.  
  122. BEGIN
  123.    i := LENGTH (InpStr);
  124.    WHILE (i >= 1) AND (InpStr [i] = ' ') DO
  125.       i := i - 1;
  126.    TrimR := COPY (InpStr, 1, i)
  127. END;
  128.  
  129. FUNCTION TrimB (InpStr : STRING) : STRING;
  130.  
  131. BEGIN
  132.  TrimB := TrimL (TrimR (InpStr) );
  133. END;
  134.  
  135. FUNCTION IntStr (Num : LONGINT; Width : BYTE; Zeros : BOOLEAN) : STRING;
  136. { Return a string value (width 'w')for the input integer ('n') }
  137.   VAR
  138.     Stg : STRING;
  139.   BEGIN
  140.     STR (Num : Width, Stg);
  141.     IF Zeros THEN BEGIN
  142.     FOR Num := 1 TO Width DO IF Stg [Num] = #32 THEN Stg [Num] := '0';
  143.     END ELSE Stg := TrimL (Stg);
  144.     IntStr := Stg;
  145.   END;
  146.  
  147. FUNCTION NameOnly (FileName : PathStr) : PathStr;
  148. { Strip any path information from a file specification }
  149. VAR
  150.    Dir  : DirStr;
  151.    Name : NameStr;
  152.    Ext  : ExtStr;
  153. BEGIN
  154.    FSplit (FileName, Dir, Name, Ext);
  155.    NameOnly := Name;
  156. END {NameOnly};
  157.  
  158. FUNCTION EraseFile ( S : PathStr ) : BOOLEAN ;
  159. VAR F : FILE;
  160. BEGIN
  161. EraseFile := FALSE;
  162. ASSIGN (F, S);
  163. RESET (F);
  164. IF IORESULT <> 0 THEN EXIT;
  165.   CLOSE (F);
  166.   ERASE (F);
  167.   EraseFile := (IORESULT = 0);
  168. END;
  169.  
  170. PROCEDURE FindSwagPath (VAR P : PathStr);
  171. VAR
  172.   S : PathStr;
  173. BEGIN
  174.   IF SwagPath <> '' THEN S := SwagPath + '\DRIVES.SWG' ELSE
  175.      S := 'DRIVES.SWG';
  176.   S := FSearch (S, GetEnv ('PATH') );
  177.   IF S = '' THEN
  178.      BEGIN
  179.      WriteLn(#7,'You GOTTA have the SWAG files somewhere on your PATH to do this !!');
  180.      WriteLn(#7,'OR, you can enter the path on the command line !!');
  181.      HALT(1);
  182.      END;
  183. S := FExpand (S);
  184. P := FExpand (COPY(S,1,POS('DRIVES',S)-1));
  185. END;
  186.  
  187. PROCEDURE FindPKZip;
  188. VAR
  189.   S : PathStr;
  190. BEGIN
  191.   S := FSearch ('PKZIP.EXE', GetEnv ('PATH') );
  192.   IF S = '' THEN
  193.      BEGIN
  194.      WriteLn(#7,'You GOTTA have PKZIP somewhere on your PATH to do this !!');
  195.      HALT(1);
  196.      END;
  197.      PKZIP := FExpand (S);
  198. END;
  199.  
  200. PROCEDURE CleanUp;
  201. { clean up after ourselves }
  202. BEGIN
  203.   FINDFIRST ('*.NDX', $21, TR);
  204.   WHILE DosError = 0 DO
  205.         BEGIN
  206.         EraseFile(TR.NAME);
  207.         FINDNEXT (TR);
  208.         END;
  209.   EraseFile('MESSAGES.DAT');
  210.   EraseFile('CONTROL.DAT');
  211. END;
  212.  
  213. PROCEDURE CreateControlDat;
  214. VAR
  215.     I : BYTE;
  216. BEGIN
  217.      ControlHdr [11] := IntStr (PRED (ConfNum), 3, FALSE);
  218.      ASSIGN (ControlF, 'CONTROL.DAT');
  219.      REWRITE (ControlF);
  220.      FOR I := 1 TO 11 DO
  221.          WRITELN (ControlF, ControlHdr [i]);
  222.      FOR I := 1 TO ControlIdx DO
  223.          WRITELN (ControlF, ControlVal [i]);
  224.      CLOSE (ControlF);
  225. END;
  226.  
  227. PROCEDURE CreateMessageDat;
  228. VAR
  229.     I    : BYTE;
  230.     Buff : BlockArray;
  231. BEGIN
  232.   FILLCHAR (ControlVal, SIZEOF (ControlVal), #0);
  233.   FILLCHAR (Buff, SIZEOF (Buff), #32);
  234.   FILLCHAR (MsgHdr, SIZEOF (MsgHdr), #32);
  235.   ConfNum    := 0;
  236.   ControlIdx := 0;
  237.   Number     := 0;
  238.   ASSIGN (QWKF, 'MESSAGES.DAT');
  239.   REWRITE (QWKF, SIZEOF (MsgHdr) );
  240.   WStr := 'SWAG TO QWK (c) 1993 GDSOFT';
  241.   FOR I := 1 TO LENGTH (WStr) DO Buff [i] := WSTR [i];
  242.   BLOCKWRITE (QwkF, Buff, 1);
  243. END;
  244.  
  245. FUNCTION ArrayTOInteger (B : CharArray; Len : BYTE) : LONGINT;
  246.  
  247. VAR I : BYTE;
  248.     S : STRING;
  249.     E  : INTEGER;
  250.     T  : INTEGER;
  251.  
  252. BEGIN
  253.     S := '';
  254.     FOR I := 1 TO PRED (Len) DO IF B [i] <> #32 THEN S := S + B [i];
  255.     VAL (S, T, E);
  256.     IF E = 0 THEN ArrayToInteger := T;
  257. END;
  258.  
  259. PROCEDURE ReadMessage (HDR : MSGDatHdr; RelNum : LONGINT; VAR Chunks : INTEGER);
  260. VAR
  261.   Buff : BlockArray;
  262.   J    : INTEGER;
  263.   I    : BYTE;
  264.   NS   : STRING;
  265.  
  266. BEGIN
  267.  
  268.   { read the header block }
  269.   SEEK (SwagF, RelNum - 1);
  270.   BLOCKREAD  (SwagF, Hdr, 1);
  271.  
  272.   { Correct the record number }
  273.   INC(Number);
  274.   NS := IntStr(Number,7,FALSE);
  275.   WHILE Length(NS) < 7 DO NS := NS + #32;
  276.   MOVE (NS, Hdr.MsgNum, 7);
  277.   Hdr.LeastSig := ConfNum;
  278.   Hdr.MostSig  := Number;
  279.  
  280.   { write the header to our QWK file }
  281.   BLOCKWRITE (QwkF,  Hdr, 1);
  282.  
  283.   { process the rest of the blocks }
  284.   Chunks := ArrayToInteger (HDR.NumChunk, 6);
  285.   FOR J := 1 TO PRED (Chunks) DO
  286.   BEGIN
  287.     BLOCKREAD  (SwagF, Buff, 1);
  288.     BLOCKWRITE (QwkF,  Buff, 1);
  289.   END;
  290.  
  291. END;
  292.  
  293. PROCEDURE ProcessSwag (FN : PathStr);
  294. VAR
  295.     ndxF : File;
  296.     b    : bSingle;
  297.     r    : REAL;
  298.     n    : LONGINT;
  299.  
  300.     { converts TP real to Microsoft 4 bytes single .. GOOFY !!!! }
  301.     procedure real_to_msb (preal : real; var b : bsingle);
  302.     var
  303.          r : array [0 .. 5] of byte absolute preal;
  304.     begin
  305.          b [3] := r [0];
  306.          move (r [3], b [0], 3);
  307.     end; { procedure real_to_msb }
  308.  
  309.  
  310. BEGIN
  311.  
  312.   WriteLn('Process .. ',FN);
  313.   { create the NDX file }
  314.   ASSIGN  (ndxF,IntStr(ConfNum,3,TRUE)+'.NDX');
  315.   REWRITE (ndxF,1);
  316.  
  317.   ASSIGN (SwagF, FN);
  318.   RESET (SwagF, SIZEOF (MsgHdr) );
  319.   Count  := 2;  { start at RECORD #2 }
  320.  
  321.   WHILE (Count < FILESIZE (SwagF) ) DO
  322.         BEGIN
  323.  
  324.         n := SUCC(FilePos(QwkF));      { ndx wants the RELATIVE position }
  325.         r := N;                        { make a REAL                     }
  326.         REAL_TO_MSB(r,b);              { convert to MSB format           }
  327.         BLOCKWRITE(ndxF,B,SizeOf(B));  { store it                        }
  328.  
  329.         ReadMessage (MSGHdr, Count, Chunks);
  330.         INC (Count, Chunks);
  331.         END;
  332.  
  333.   CLOSE (SwagF);
  334.   CLOSE (NdxF);
  335.  
  336.   { update the CONTROL file array }
  337.   INC (ControlIdx);
  338.   ControlVal [ControlIdx] := IntStr (ConfNum, 3, TRUE);
  339.   INC (ControlIdx);
  340.   ControlVal [ControlIdx] := NameOnly (FN);
  341.   INC (ConfNum);
  342.  
  343. END;
  344.  
  345.  
  346. BEGIN
  347.  
  348.   ClrScr;
  349.  
  350.   IF ParamCount > 0 THEN SwagPath := FExpand(ParamStr(1));
  351.  
  352.   EraseFile('SWAG.QWK');  { make sure we don't have one yet }
  353.  
  354.   FindSwagPath (SwagPath);
  355.  
  356.   FindPkZip;
  357.  
  358.   CreateMessageDat;
  359.  
  360.   IF SwagPath [LENGTH (SwagPath) ] <> '\' THEN SwagPath := SwagPath + '\';
  361.  
  362.   FINDFIRST (SwagPath + '*.SWG', $21, TR);
  363.   WHILE DosError = 0 DO
  364.         BEGIN
  365.         ProcessSwag (SwagPath + TR.Name);
  366.         FINDNEXT (TR);
  367.         END;
  368.  
  369.   CLOSE (QwkF);
  370.  
  371.   CreateControlDat;
  372.  
  373.   SwapVectors;
  374.   Exec(PKZIP,' -ex SWAG.QWK *.NDX MESSAGES.DAT CONTROL.DAT');
  375.   SwapVectors;
  376.  
  377.   CleanUp;
  378.  
  379. END.
  380.